home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_gnu / adainc / a-textio.adb < prev    next >
Text File  |  1996-01-30  |  22KB  |  856 lines

  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                         GNAT RUNTIME COMPONENTS                          --
  4. --                                                                          --
  5. --                          A D A . T E X T _ I O                           --
  6. --                                                                          --
  7. --                                 B o d y                                  --
  8. --                                                                          --
  9. --                            $Revision: 1.23 $                             --
  10. --                                                                          --
  11. --           Copyright (c) 1992,1993,1994 NYU, All Rights Reserved          --
  12. --                                                                          --
  13. -- The GNAT library is free software; you can redistribute it and/or modify --
  14. -- it under terms of the GNU Library General Public License as published by --
  15. -- the Free Software  Foundation; either version 2, or (at your option) any --
  16. -- later version.  The GNAT library is distributed in the hope that it will --
  17. -- be useful, but WITHOUT ANY WARRANTY;  without even  the implied warranty --
  18. -- of MERCHANTABILITY  or  FITNESS FOR  A PARTICULAR PURPOSE.  See the  GNU --
  19. -- Library  General  Public  License for  more  details.  You  should  have --
  20. -- received  a copy of the GNU  Library  General Public License  along with --
  21. -- the GNAT library;  see the file  COPYING.LIB.  If not, write to the Free --
  22. -- Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.        --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Ada.Text_IO.Aux;
  27. with System.Unsigned_Types;
  28. package body Ada.Text_IO is
  29.  
  30.    -----------------------
  31.    -- Local Subprograms --
  32.    -----------------------
  33.  
  34.    procedure Unimplemented (Message : String);
  35.    --  Output message for unimplemented feature
  36.  
  37.    -------------------
  38.    -- Unimplemented --
  39.    -------------------
  40.  
  41.    procedure Unimplemented (Message : String) is
  42.    begin
  43.       Put (Message);
  44.       Put_Line (" not implemented yet");
  45.       raise Program_Error;
  46.    end Unimplemented;
  47.  
  48.    ---------------------
  49.    -- File Management --
  50.    ---------------------
  51.  
  52.    procedure Create
  53.      (File : in out File_Type;
  54.       Mode : in File_Mode := Out_File;
  55.       Name : in String := "";
  56.       Form : in String := "")
  57.    renames Text_IO.Aux.Create;
  58.  
  59.    procedure Open
  60.      (File : in out File_Type;
  61.       Mode : in File_Mode;
  62.       Name : in String;
  63.       Form : in String := "")
  64.    renames Text_IO.Aux.Open;
  65.  
  66.    procedure Close  (File : in out File_Type) renames Text_IO.Aux.Close;
  67.    procedure Delete (File : in out File_Type) renames Text_IO.Aux.Delete;
  68.  
  69.    procedure Reset
  70.      (File : in out File_Type;
  71.       Mode : in File_Mode)
  72.    renames Text_IO.Aux.Reset;
  73.  
  74.    procedure Reset (File : in out File_Type) is
  75.    begin
  76.       Text_IO.Aux.Reset (File, Text_IO.Aux.Mode (File));
  77.    end Reset;
  78.  
  79.    function Mode (File : in File_Type) return File_Mode
  80.      renames Text_IO.Aux.Mode;
  81.  
  82.    function Name (File : in File_Type) return String renames Text_IO.Aux.Name;
  83.    function Form (File : in File_Type) return String renames Text_IO.Aux.Form;
  84.  
  85.    function Is_Open (File : in File_Type) return Boolean
  86.      renames Text_IO.Aux.Is_Open;
  87.  
  88.    procedure Set_Input  (File : in File_Type) renames Text_IO.Aux.Set_Input;
  89.    procedure Set_Output (File : in File_Type) renames Text_IO.Aux.Set_Output;
  90.    procedure Set_Error  (File : in File_Type) renames Text_IO.Aux.Set_Error;
  91.  
  92.    function Standard_Input return File_Type
  93.      renames Text_IO.Aux.Standard_Input;
  94.  
  95.    function Standard_Output return File_Type
  96.      renames Text_IO.Aux.Standard_Output;
  97.  
  98.    function Standard_Error return File_Type
  99.      renames Text_IO.Aux.Standard_Error;
  100.  
  101.    function Current_Input  return File_Type renames Text_IO.Aux.Current_Input;
  102.    function Current_Output return File_Type renames Text_IO.Aux.Current_Output;
  103.    function Current_Error  return File_Type renames Text_IO.Aux.Current_Error;
  104.  
  105.    function Standard_Input return File_Access is
  106.    begin
  107.       return Text_IO.Aux.Standard_In'Access;
  108.    end Standard_Input;
  109.  
  110.    function Standard_Output return File_Access is
  111.    begin
  112.       return Text_IO.Aux.Standard_Out'Access;
  113.    end Standard_Output;
  114.  
  115.    function Standard_Error return File_Access is
  116.    begin
  117.       return Text_IO.Aux.Standard_Err'Access;
  118.    end Standard_Error;
  119.  
  120.    function Current_Input  return File_Access is
  121.    begin
  122.       return Text_IO.Aux.Current_In'Access;
  123.    end Current_Input;
  124.  
  125.    function Current_Output return File_Access is
  126.    begin
  127.       return Text_IO.Aux.Current_Out'Access;
  128.    end Current_Output;
  129.  
  130.    function Current_Error  return File_Access is
  131.    begin
  132.       return Text_IO.Aux.Current_Err'Access;
  133.    end Current_Error;
  134.  
  135.    --------------------
  136.    -- Buffer control --
  137.    --------------------
  138.  
  139.    procedure Flush (File : in out File_Type) is
  140.    begin
  141.       Unimplemented ("Flush");
  142.       raise Program_Error;
  143.    end Flush;
  144.  
  145.    procedure Flush is
  146.    begin
  147.       Unimplemented ("Flush");
  148.       raise Program_Error;
  149.    end Flush;
  150.  
  151.    --------------------------------------------
  152.    -- Specification of line and page lengths --
  153.    --------------------------------------------
  154.  
  155.    procedure Set_Line_Length (File : in File_Type; To : in Count)
  156.      renames Text_IO.Aux.Set_Line_Length;
  157.  
  158.    procedure Set_Line_Length (To : in Count) is
  159.    begin
  160.       Text_IO.Aux.Set_Line_Length (Current_Output, To);
  161.    end Set_Line_Length;
  162.  
  163.    function Line_Length (File : in File_Type) return Count
  164.      renames Text_IO.Aux.Line_Length;
  165.  
  166.    function Line_Length return Count is
  167.    begin
  168.       return Text_IO.Aux.Line_Length (Current_Output);
  169.    end Line_Length;
  170.  
  171.    procedure Set_Page_Length (File : in File_Type; To : in Count)
  172.      renames Text_IO.Aux.Set_Page_Length;
  173.  
  174.    procedure Set_Page_Length (To : in Count) is
  175.    begin
  176.       Text_IO.Aux.Set_Page_Length (Current_Output, To);
  177.    end Set_Page_Length;
  178.  
  179.    function Page_Length (File : in File_Type) return Count
  180.      renames Text_IO.Aux.Page_Length;
  181.  
  182.    function Page_Length return Count is
  183.    begin
  184.       return Page_Length (Current_Output);
  185.    end Page_Length;
  186.  
  187.    ------------------------------------
  188.    -- Column, Line, and Page Control --
  189.    ------------------------------------
  190.  
  191.    procedure New_Line (File : in File_Type; Spacing : in Positive_Count := 1)
  192.      renames Text_IO.Aux.New_Line;
  193.  
  194.    procedure New_Line (Spacing : in Positive_Count := 1) is
  195.    begin
  196.       New_Line (Current_Output, Spacing);
  197.    end New_Line;
  198.  
  199.    procedure Skip_Line
  200.      (File    : in File_Type;
  201.       Spacing : in Positive_Count := 1)
  202.    renames Text_IO.Aux.Skip_Line;
  203.  
  204.    procedure Skip_Line (Spacing : in Positive_Count := 1) is
  205.    begin
  206.       Skip_Line (Current_Input, Spacing);
  207.    end Skip_Line;
  208.  
  209.    function End_Of_Line (File : in File_Type) return Boolean
  210.      renames Text_IO.Aux.End_Of_Line;
  211.  
  212.    function End_Of_Line return Boolean is
  213.    begin
  214.       return End_Of_Line (Current_Input);
  215.    end End_Of_Line;
  216.  
  217.    procedure New_Page (File : in File_Type) renames Text_IO.Aux.New_Page;
  218.  
  219.    procedure New_Page is
  220.    begin
  221.       New_Page (Current_Output);
  222.    end New_Page;
  223.  
  224.    procedure Skip_Page (File : in File_Type) renames Text_IO.Aux.Skip_Page;
  225.  
  226.    procedure Skip_Page is
  227.    begin
  228.       Skip_Page (Current_Input);
  229.    end Skip_Page;
  230.  
  231.    function End_Of_Page (File : in File_Type) return Boolean
  232.      renames Text_IO.Aux.End_Of_Page;
  233.  
  234.    function End_Of_Page return Boolean is
  235.    begin
  236.       return End_Of_Page (Current_Input);
  237.    end End_Of_Page;
  238.  
  239.    function End_Of_File (File : in File_Type) return Boolean
  240.      renames Text_IO.Aux.End_Of_File;
  241.  
  242.    function End_Of_File return Boolean is
  243.    begin
  244.       return End_Of_File (Current_Input);
  245.    end End_Of_File;
  246.  
  247.    procedure Set_Col
  248.      (File : in File_Type;
  249.       To   : in Positive_Count)
  250.    renames Text_IO.Aux.Set_Col;
  251.  
  252.    procedure Set_Col (To : in Positive_Count) is
  253.    begin
  254.       Set_Col (Current_Output, To);
  255.    end Set_Col;
  256.  
  257.    procedure Set_Line
  258.      (File : in File_Type;
  259.       To   : in Positive_Count)
  260.    renames Text_IO.Aux.Set_Line;
  261.  
  262.    procedure Set_Line (To : in Positive_Count) is
  263.    begin
  264.       Set_Line (Current_Output, To);
  265.    end Set_Line;
  266.  
  267.    function Col (File : in File_Type) return Positive_Count
  268.      renames Text_IO.Aux.Col;
  269.  
  270.    function Col return Positive_Count is
  271.    begin
  272.       return Col (Current_Output);
  273.    end Col;
  274.  
  275.    function Line (File : in File_Type) return Positive_Count
  276.      renames Text_IO.Aux.Line;
  277.  
  278.    function Line return Positive_Count is
  279.    begin
  280.       return Line (Current_Output);
  281.    end Line;
  282.  
  283.    function Page (File : in File_Type) return Positive_Count
  284.      renames Text_IO.Aux.Page;
  285.  
  286.    function Page return Positive_Count is
  287.    begin
  288.       return Page (Current_Output);
  289.    end Page;
  290.  
  291.    -------------------------------
  292.    --  Characters Input-Output  --
  293.    -------------------------------
  294.  
  295.    procedure Get
  296.      (File : in File_Type;
  297.       Item : out Character)
  298.    is
  299.    begin
  300.       Text_IO.Aux.The_File := File;
  301.       Text_IO.Aux.Get (Item);
  302.    end Get;
  303.  
  304.  
  305.    procedure Get (Item : out Character) is
  306.    begin
  307.       Get (Current_Input, Item);
  308.    end Get;
  309.  
  310.    procedure Put
  311.      (File : in File_Type;
  312.       Item : in Character)
  313.    is
  314.    begin
  315.       Text_IO.Aux.The_File := File;
  316.       Text_IO.Aux.Put (Item);
  317.    end Put;
  318.  
  319.    procedure Put (Item : in Character) is
  320.    begin
  321.       Put (Current_Output, Item);
  322.    end Put;
  323.  
  324.    procedure Look_Ahead
  325.      (File        : in File_Type;
  326.       Item        : out Character;
  327.       End_Of_Line : out Boolean)
  328.    is
  329.    begin
  330.       Unimplemented ("Look_Ahead");
  331.       raise Program_Error;
  332.    end Look_Ahead;
  333.  
  334.    procedure Look_Ahead
  335.      (Item        : out Character;
  336.       End_of_Line : out Boolean)
  337.    is
  338.    begin
  339.       Unimplemented ("Look_Ahead");
  340.       raise Program_Error;
  341.    end Look_Ahead;
  342.  
  343.    procedure Get_Immediate
  344.      (File : in File_Type;
  345.       Item : out Character)
  346.    is
  347.    begin
  348.       Unimplemented ("Get_Immediate");
  349.       raise Program_Error;
  350.    end Get_Immediate;
  351.  
  352.    procedure Get_Immediate (Item : out Character) is
  353.    begin
  354.       Unimplemented ("Get_Immediate");
  355.       raise Program_Error;
  356.    end Get_Immediate;
  357.  
  358.    procedure Get_Immediate
  359.      (File      : in File_Type;
  360.       Item      : out Character;
  361.       Available : out Boolean)
  362.    is
  363.    begin
  364.       Unimplemented ("Get_Immediate");
  365.       raise Program_Error;
  366.    end Get_Immediate;
  367.  
  368.    procedure Get_Immediate
  369.      (Item      : out Character;
  370.       Available : out Boolean)
  371.    is
  372.    begin
  373.       Unimplemented ("Get_Immediate");
  374.       raise Program_Error;
  375.    end Get_Immediate;
  376.  
  377.    ---------------------------
  378.    -- Strings Input-Output  --
  379.    ---------------------------
  380.  
  381.    procedure Get
  382.      (File : in File_Type;
  383.       Item : out String)
  384.    is
  385.    begin
  386.       Text_IO.Aux.The_File := File;
  387.       Text_IO.Aux.Get (Item);
  388.    end Get;
  389.  
  390.    procedure Get (Item : out String) is
  391.    begin
  392.       Get (Current_Input, Item);
  393.    end Get;
  394.  
  395.    procedure Put
  396.      (File : in File_Type;
  397.       Item : in String)
  398.    is
  399.    begin
  400.       Text_IO.Aux.The_File := File;
  401.       Text_IO.Aux.Put (Item);
  402.    end Put;
  403.  
  404.    procedure Put (Item : in String) is
  405.    begin
  406.       Put (Current_Output, Item);
  407.    end Put;
  408.  
  409.    procedure Get_Line
  410.      (File : in File_Type;
  411.       Item : out String;
  412.       Last : out Natural)
  413.    renames Text_IO.Aux.Get_Line;
  414.  
  415.    procedure Get_Line
  416.      (Item : out String;
  417.       Last : out Natural)
  418.    is
  419.    begin
  420.       Get_Line (Current_Input, Item, Last);
  421.    end Get_Line;
  422.  
  423.    procedure Put_Line
  424.      (File : in File_Type;
  425.       Item : in String)
  426.    renames Text_IO.Aux.Put_Line;
  427.  
  428.    procedure Put_Line (Item : in String) is
  429.    begin
  430.       Put_Line (Current_Output, Item);
  431.    end Put_Line;
  432.  
  433.    -------------------------------------
  434.    --  Input-Output of Integer Types  --
  435.    -------------------------------------
  436.  
  437.    package body Integer_Io is
  438.       subtype LLI is Long_Long_Integer;
  439.  
  440.       Num_First : LLI := LLI (Num'First);
  441.       Num_Last  : LLI := LLI (Num'Last);
  442.  
  443.       procedure Get
  444.         (File  : in File_Type;
  445.          Item  : out Num;
  446.          Width : in Field := 0)
  447.       is
  448.          X : Integer;
  449.  
  450.       begin
  451.          if Num'Size > Integer'Size then
  452.             Unimplemented ("Get on this type (Num too big)");
  453.          end if;
  454.  
  455.          Text_IO.Aux.The_File := File;
  456.          Text_IO.Aux.Get_Int (X, Width);
  457.  
  458.          if LLI (X) < Num_First or else LLI (X) > Num_Last then
  459.             raise Data_Error;
  460.          end if;
  461.  
  462.          Item := Num (X);
  463.       end Get;
  464.  
  465.       procedure Get
  466.         (Item  : out Num;
  467.          Width : in Field := 0)
  468.       is
  469.       begin
  470.          Get (Current_Input, Item, Width);
  471.       end Get;
  472.  
  473.       procedure Put
  474.         (File  : in File_Type;
  475.          Item  : in Num;
  476.          Width : in Field := Default_Width;
  477.          Base  : in Number_Base := Default_Base)
  478.       is
  479.       begin
  480.          Text_IO.Aux.The_File := File;
  481.  
  482.          if Num'Size > Integer'Size then
  483.             Text_IO.Aux.Put_LLI (LLI (Item), Width, Base);
  484.          else
  485.             Text_IO.Aux.Put_Integer (Integer (Item), Width, Base);
  486.          end if;
  487.       end Put;
  488.  
  489.       procedure Put
  490.         (Item  : in Num;
  491.          Width : in Field := Default_Width;
  492.          Base  : in Number_Base := Default_Base)
  493.       is
  494.       begin
  495.          Put (Current_Output, Item, Width, Base);
  496.       end Put;
  497.  
  498.       procedure Get
  499.         (From : in String;
  500.          Item : out Num;
  501.          Last : out Positive)
  502.       is
  503.          Pos : Positive;
  504.          X   : LLI;
  505.  
  506.       begin
  507.          Text_IO.Aux.Get_LLI (From, X, Pos, Num'Size);
  508.          if X < Num_First or else X > Num_Last then
  509.             raise Data_Error;
  510.          end if;
  511.  
  512.          Item := Num (X);
  513.          Last := Pos;
  514.       end Get;
  515.  
  516.  
  517.       procedure Put
  518.         (To   : out String;
  519.          Item : in Num;
  520.          Base : in Number_Base := Default_Base)
  521.       is
  522.       begin
  523.          if Num'Size > Integer'Size then
  524.             Text_IO.Aux.Put_LLI (To, LLI (Item), Base);
  525.          else
  526.             Text_IO.Aux.Put_Integer (To, Integer (Item), Base);
  527.          end if;
  528.       end Put;
  529.  
  530.    end Integer_Io;
  531.  
  532.    -------------------------------------
  533.    --  Input-Output of Modular Types  --
  534.    -------------------------------------
  535.  
  536.    package body Modular_IO is
  537.       use System.Unsigned_Types;
  538.       subtype LLU is Long_Long_Unsigned;
  539.  
  540.       Num_First : LLU := LLU (Num'First);
  541.       Num_Last  : LLU := LLU (Num'Last);
  542.  
  543.       procedure Get
  544.         (File  : in File_Type;
  545.          Item  : out Num;
  546.          Width : in Field := 0)
  547.       is
  548.       begin
  549.          Unimplemented ("Modular Get");
  550.       end Get;
  551.  
  552.       procedure Get
  553.         (Item  : out Num;
  554.          Width : in Field := 0)
  555.       is
  556.       begin
  557.          Get (Current_Input, Item, Width);
  558.       end Get;
  559.  
  560.       procedure Put
  561.         (File  : in File_Type;
  562.          Item  : in Num;
  563.          Width : in Field := Default_Width;
  564.          Base  : in Number_Base := Default_Base)
  565.       is
  566.       begin
  567.          Text_IO.Aux.The_File := File;
  568.  
  569.          if Num'Size > Unsigned'Size then
  570.             Text_IO.Aux.Put_LLU (LLU (Item), Width, Base);
  571.          else
  572.             Text_IO.Aux.Put_Unsigned (Unsigned (Item), Width, Base);
  573.          end if;
  574.       end Put;
  575.  
  576.       procedure Put
  577.         (Item  : in Num;
  578.          Width : in Field := Default_Width;
  579.          Base  : in Number_Base := Default_Base)
  580.       is
  581.       begin
  582.          Put (Current_Output, Item, Width, Base);
  583.       end Put;
  584.  
  585.       procedure Get
  586.         (From : in String;
  587.          Item : out Num;
  588.          Last : out Positive)
  589.       is
  590.          Pos  : Positive;
  591.          X    : LLU;
  592.  
  593.       begin
  594.          Text_IO.Aux.Get_LLU (From, X, Pos, Num'Size);
  595.  
  596.          if X < Num_First or else X > Num_Last then
  597.             raise Data_Error;
  598.          end if;
  599.  
  600.          Item := Num (X);
  601.          Last := Pos;
  602.       end Get;
  603.  
  604.       procedure Put
  605.         (To   : out String;
  606.          Item : in Num;
  607.          Base : in Number_Base := Default_Base)
  608.       is
  609.       begin
  610.          if Num'Size > Unsigned'Size then
  611.             Text_IO.Aux.Put_LLU (To, LLU (Item), Base);
  612.          else
  613.             Text_IO.Aux.Put_Unsigned (To, Unsigned (Item), Base);
  614.          end if;
  615.       end Put;
  616.  
  617.    end Modular_IO;
  618.  
  619.    ---------------------------------
  620.    -- Input-Output of Float Types --
  621.    ---------------------------------
  622.  
  623.    package body Float_Io is
  624.  
  625.       Num_First : Aux.LLF := Aux.LLF (Num'First);
  626.       Num_Last  : Aux.LLF := Aux.LLF (Num'Last);
  627.  
  628.       procedure Get
  629.         (File : in File_Type;
  630.          Item : out Num;
  631.          Width : in Field := 0)
  632.       is
  633.          X : Aux.LLF;
  634.  
  635.       begin
  636.          Text_IO.Aux.The_File := File;
  637.          Text_IO.Aux.Get_Float (X, Width);
  638.  
  639.          if X < Num_First or else X > Num_Last then
  640.             raise Data_Error;
  641.          end if;
  642.  
  643.          Item := Num (X);
  644.       end Get;
  645.  
  646.       procedure Get
  647.         (Item : out Num;
  648.          Width : in Field := 0)
  649.       is
  650.       begin
  651.          Get (Current_Input, Item, Width);
  652.       end Get;
  653.  
  654.       procedure Put
  655.         (File : in File_Type;
  656.          Item : in Num;
  657.          Fore : in Field := Default_Fore;
  658.          Aft  : in Field := Default_Aft;
  659.          Exp  : in Field := Default_Exp)
  660.       is
  661.       begin
  662.          Text_IO.Aux.The_File := File;
  663.          Text_IO.Aux.Put_Float (Aux.LLF (Item), Fore, Aft, Exp);
  664.       end Put;
  665.  
  666.       procedure Put
  667.         (Item : in Num;
  668.          Fore : in Field := Default_Fore;
  669.          Aft  : in Field := Default_Aft;
  670.          Exp : in Field := Default_Exp)
  671.       is
  672.       begin
  673.          Put (Current_Output, Item, Fore, Aft, Exp);
  674.       end Put;
  675.  
  676.       procedure Get
  677.         (From : in String;
  678.          Item : out Num;
  679.          Last : out Positive)
  680.       is
  681.       begin
  682.          Text_IO.Aux.Get_Float (From, Aux.LLF (Item), Last);
  683.       end Get;
  684.  
  685.       procedure Put
  686.         (To : out String;
  687.          Item : in Num;
  688.          Aft : in Field := Default_Aft;
  689.          Exp : in Field := Default_Exp)
  690.       is
  691.       begin
  692.          Text_IO.Aux.Put_Float (To, Aux.LLF (Item), Aft, Exp);
  693.       end Put;
  694.  
  695.    end Float_Io;
  696.  
  697.    package body Fixed_Io is
  698.  
  699.       X : Aux.LLF;
  700.  
  701.       procedure Get
  702.         (File  : in File_Type;
  703.          Item  : out Num;
  704.          Width : in Field := 0)
  705.       is
  706.       begin
  707.          Text_IO.Aux.The_File := File;
  708.          Text_IO.Aux.Get_Float (X, Width);
  709.          --  ???
  710.          --  if X < Aux.LLF (Num'First) or else X > Aux.LLF (Num'Last) then
  711.          --     raise Data_Error;
  712.          --  end if;
  713.          Item := Num (X);
  714.       end Get;
  715.  
  716.       procedure Get
  717.         (Item  : out Num;
  718.          Width : in Field := 0)
  719.       is
  720.       begin
  721.          Get (Current_Input, Item, Width);
  722.       end Get;
  723.  
  724.       procedure Put
  725.         (File : in File_Type;
  726.          Item : in Num;
  727.          Fore : in Field := Default_Fore;
  728.          Aft  : in Field := Default_Aft;
  729.          Exp  : in Field := Default_Exp)
  730.       is
  731.       begin
  732.          Text_IO.Aux.The_File := File;
  733.          Text_IO.Aux.Put_Float (Aux.LLF (Item), Fore, Aft, Exp);
  734.       end Put;
  735.  
  736.       procedure Put
  737.         (Item : in Num;
  738.          Fore : in Field := Default_Fore;
  739.          Aft  : in Field := Default_Aft;
  740.          Exp  : in Field := Default_Exp)
  741.       is
  742.       begin
  743.          Put (Current_Output, Item, Fore, Aft, Exp);
  744.       end Put;
  745.  
  746.       procedure Get
  747.         (From : in String;
  748.          Item : out Num; Last : out Positive)
  749.       is
  750.       begin
  751.          Text_IO.Aux.Get_Float (From, X, Last);
  752.          --  ???
  753.          --  if X < Aux.LLF (Num'First) or else X > Aux.LLF (Num'Last) then
  754.          --     raise Data_Error;
  755.          --  end if;
  756.          Item := Num (X);
  757.       end Get;
  758.  
  759.       procedure Put
  760.         (To   : out String;
  761.          Item : in Num;
  762.          Aft  : in Field := Default_Aft;
  763.          Exp  : in Field := Default_Exp)
  764.       is
  765.       begin
  766.          Text_IO.Aux.Put_Float (To, Aux.LLF (Item), Aft, Exp);
  767.       end Put;
  768.  
  769.    end Fixed_Io;
  770.  
  771.    ---------------------------------------
  772.    -- Input-Output of Enumeration Types --
  773.    ---------------------------------------
  774.  
  775.    package body Enumeration_Io is
  776.  
  777.       --  S : String (1 .. Enum'Width);
  778.       S : String (1 .. 255); -- ???
  779.  
  780.       procedure Get
  781.         (File : in File_Type;
  782.          Item : out Enum)
  783.       is
  784.          Len : Positive;
  785.  
  786.       begin
  787.          Text_IO.Aux.The_File := File;
  788.          Text_IO.Aux.Get_Enum (S, Len);
  789.  
  790.          for E in Enum'Range loop
  791.             if Enum'Image (E) = S (1 .. Len) then
  792.                Item := E;
  793.                return;
  794.             end if;
  795.          end loop;
  796.          raise Data_Error;
  797.       end Get;
  798.  
  799.       procedure Get (Item : out Enum) is
  800.       begin
  801.          Get (Current_Input, Item);
  802.       end Get;
  803.  
  804.       procedure Put
  805.         (File  : in File_Type;
  806.          Item  : in Enum;
  807.          Width : in Field := Default_Width;
  808.          Set   : in Type_Set := Default_Setting)
  809.       is
  810.       begin
  811.          Text_IO.Aux.The_File := File;
  812.          Text_IO.Aux.Put_Enum (Enum'Image (Item), Width, Set);
  813.       end Put;
  814.  
  815.       procedure Put
  816.         (Item  : in Enum;
  817.          Width : in Field := Default_Width;
  818.          Set   : in Type_Set := Default_Setting)
  819.       is
  820.       begin
  821.          Put (Current_Output, Item, Width, Set);
  822.       end Put;
  823.  
  824.       procedure Get
  825.         (From : in String;
  826.          Item : out Enum;
  827.          Last : out Positive)
  828.       is
  829.          Len : Positive;
  830.  
  831.       begin
  832.          Text_IO.Aux.Get_Enum (S, From, Len, Last);
  833.  
  834.          for E in Enum'Range loop
  835.             if Enum'Image (E) = S (1 .. Len) then
  836.                Item := E;
  837.                return;
  838.             end if;
  839.          end loop;
  840.  
  841.          raise Data_Error;
  842.       end Get;
  843.  
  844.       procedure Put
  845.         (To   : out String;
  846.          Item : in Enum;
  847.          Set  : in Type_Set := Default_Setting)
  848.       is
  849.       begin
  850.          Text_IO.Aux.Put_Enum (To, Enum'Image (Item), Set);
  851.       end Put;
  852.  
  853.    end Enumeration_Io;
  854.  
  855. end Ada.Text_IO;
  856.